home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
swags_z.zip
/
SCREEN.SWG
/
0075_Universal Fastwrite.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-03-03
|
4KB
|
106 lines
(*
Re: Copy of: Submission for SWAG
Here is a unit I have developed for very fast direct screen writes.
This unit is, unless you know better, the fastest direct direct write
procedure available. This is because it is optimised to use word
size moves on word boundaries where possible.
It also works in both real and protected modes.
*)
{$S-}
UNIT FWrite;
INTERFACE
PROCEDURE FastWrite(Col, Row, Attr : Byte; Str : String);
{Fast Direct Screen Writes for Real/Protected Mode Programs. }
{Note: 'Col' and 'Row' are zero relative, ie:- 0,0 for Top-Left.}
IMPLEMENTATION
USES
Crt;
PROCEDURE FastWrite(Col, Row, Attr : Byte; Str : String); ASSEMBLER;
ASM
PUSH DS {Save DS}
MOV DL,CheckSnow {Save CheckSnow Setting}
MOV ES,SegB800 {ES = Colour Screen Segment}
MOV SI,SegB000 {SI = Mono Screen Segment}
MOV DS,Seg0040 {DS = ROM Bios Segment}
MOV BX,[49h] {BL = CRT Mode, BH = ScreenWidth}
MOV AL,Row {AL = Row No}
MUL BH {AX = Row * ScreenWidth}
XOR CH,CH {CH = 0}
MOV CL,Col {CX = Column No}
ADD AX,CX {(Row*ScreenWidth)+Column}
ADD AX,AX {Multiply by 2 (2 Byte per Position)}
MOV DI,AX {DI = Screen Offset}
CMP BL,7 {CRT Mode = Mono?}
JNE @@DestSet {No - Use Colour Screen Segment}
MOV ES,SI {Yes - ES = Mono Screen Segment}
XOR DX,DX {Force jump to FWrite}
@@DestSet: {ES:DI = Screen Destination Address}
LDS SI,Str {DS:SI = Source String}
CLD {Move Forward through String}
LODSB {Get Length Byte of String}
MOV CL,AL {CX = Input String Length}
JCXZ @@Done {Exit if Null String}
MOV AH,Attr {AH = Attribute}
OR DL,DL {Test Mono/CheckSnow Flag}
JZ @@FWrite {Snow Checking Disabled or Mono - Use FWrite}
{Output during Screen Retrace's}
MOV DX,003DAh {6845 Status Port}
@@WaitLoop: {Output during Retrace's}
MOV BL,[SI] {Load Next Character into BL}
INC SI {Update Source Pointer}
CLI {Interrupts off}
@@Wait1: {Wait for End of Retrace}
IN AL,DX {Get 6845 status}
TEST AL,8 {Vertical Retrace in Progress?}
JNZ @@Write {Yes - Output Next Char}
SHR AL,1 {Horizontal Retrace in Progress?}
JC @@Wait1 {Yes - Wait until End of Retrace}
@@Wait2: {Wait for Start of Next Retrace}
IN AL,DX {Get 6845 status}
SHR AL,1 {Horizontal Retrace in Progress?}
JNC @@Wait2 {No - Wait until Retrace Starts}
@@Write: {Output Char and Attribute}
MOV AL,BL {Put Char to Write into AL}
STOSW {Store Character and Attribute}
STI {Interrupts On}
LOOP @@WaitLoop {Repeat for Each Character}
JMP @@Done {Exit}
{Ignore Screen Retrace's}
@@FWrite: {Output Ignoring Retrace's}
TEST SI,1 {DS:SI an Even Offset?}
JZ @@Words {Yes - Skip (On Even Boundary)}
LODSB {Get 1st Char}
STOSW {Write 1st Char and Attrib}
DEC CX {Decrement Count}
JCXZ @@Done {Finished if only 1 Char in Str}
@@Words: {DS:SI Now on Word Boundary}
SHR CX,1 {CX = Char Pairs, Set CF if Odd Byte Left}
JZ @@ChkOdd {Skip if No Pairs to Store}
@@Loop: {Loop Outputing 2 Chars per Loop}
MOV BH,AH {BH = Attrib}
LODSW {Load 2 Chars}
XCHG AH,BH {AL = 1st Char, AH = Attrib, BH = 2nd Char}
STOSW {Store 1st Char and Attrib}
MOV AL,BH {AL = 2nd Char}
STOSW {Store 2nd Char and Attrib}
LOOP @@Loop {Repeat for Each Pair of Chars}
@@ChkOdd: {Check for Final Char}
JNC @@Done {Skip if No Odd Char to Display}
LODSB {Get Last Char}
STOSW {Store Last Char and Attribute}
@@Done: {Finished}
POP DS {Restore DS}
END; {FastWrite}
END.